perm filename TRAJCT.SAI[1,BGB] blob sn#001267 filedate 1972-10-22 generic text, type T, neo UTF8
00100	BEGIN	"TRAJCT"
00200		DEFINE	α = "COMMENT";
00300	α DISPLAY DECLARATION;
00400		INTEGER ARRAY DPYBUF [1:500];
00500		REQUIRE "DISPLY[SYS,BGB]" LOAD_MODULE;
00600		EXTERNAL PROCEDURE DPYSET (INTEGER ARRAY DPYBUF);
00700		EXTERNAL PROCEDURE AIVECT (INTEGER X,Y);
00800		EXTERNAL PROCEDURE  AVECT (INTEGER X,Y);
00900		EXTERNAL PROCEDURE DPYOUT (INTEGER POG);
01000		EXTERNAL PROCEDURE DPYSST (STRING S);
01100	α TRIG DECLARATIONS;
01200		DEFINE	π = "3.1415927";
01300		REQUIRE "SAITRG[SYS,BGB]" LOAD_MODULE;
01400		EXTERNAL REAL PROCEDURE SIN (REAL X);
01500		EXTERNAL REAL PROCEDURE COS (REAL X);
01600		EXTERNAL REAL PROCEDURE ACOS (REAL X);
01700		EXTERNAL REAL PROCEDURE SQRT (REAL X);
01800	α NUMBER OF POINTS HORIZONTAL & VERTICAL, OF ARCSEGS, OF VECTORS 3D OUT;
01900		INTEGER N1,N2,N3,N4;
     

00100	REAL PROCEDURE DETERM (REAL ARRAY A);
00200	BEGIN
00300		REAL Z1,Z2,Z3,Z4;
00400		REAL A11,A12,A13,A14,A21,A22,A23,A24,A31,A32,A33,A34,A41,A42,A43,A44;
00500		DEFINE DET3BY3 (A11,A12,A13,A21,A22,A23,A31,A32,A33)
00600		=      "(A11*(A22*A33-A23*A32) 	
00700		       - A12*(A21*A33-A23*A31) 
00800		       + A13*(A21*A32-A22*A31))";
00900		ARRBLT(A11,A[1,1],16);
01000		Z1	←	+A11*DET3BY3(A22,A23,A24,A32,A33,A34,A42,A43,A44);
01100		Z2	←	-A12*DET3BY3(A21,A23,A24,A31,A33,A34,A41,A43,A44);
01200		Z3	←	+A13*DET3BY3(A21,A22,A24,A31,A32,A34,A41,A42,A44);
01300		Z4	←	-A14*DET3BY3(A21,A22,A23,A31,A32,A33,A41,A42,A43);
01400		RETURN	(Z1+Z2+Z3+Z4);
01500	END;
     

00100	α COMPUTE SPLINE COEFFICIENTS OF Z-ELEVATION BETWEEN GRADES;
00200		BOOLEAN FLGZ;
00300		REAL ARRAY COEF [1:4];
00400	PROCEDURE SPLINE (REAL L1,Z1,L2,Z2,L3,Z3);
00500	BEGIN	"SPLINE"
00600		REAL ARRAY X[1:4],A[1:4,1:4];
00700		INTEGER I,J;	REAL E;
00800	
00900		A[1,1]←L1↑3;	A[1,2]←L1↑2;	A[1,3]←L1;	A[1,4]←1;
01000		A[2,1]←L3↑3;	A[2,2]←L3↑2;	A[2,3]←L3;	A[2,4]←1;
01100		A[3,1]←3*L1↑2;	A[3,2]←2*L1;	A[3,3]←1;	A[3,4]←0;
01200		A[4,1]←3*L3↑2;	A[4,2]←2*L3;	A[4,3]←1;	A[4,4]←0;
01300	
01400		E	←	DETERM (A);
01500		X[1]	←	Z1;
01600		X[2]	←	Z3;
01700		X[3]	←	(Z2-Z1) / (L2-L1);
01800		X[4]	←	(Z3-Z2) / (L3-L2);
01900	
02000		FOR I←1 STEP 1 UNTIL 4 DO
02100	BEGIN
02200		FOR J←1 STEP 1 UNTIL 4 DO  A[J,I] ↔ X[J];
02300		COEF[I]	←	DETERM (A) /E;
02400		FOR J←1 STEP 1 UNTIL 4 DO  A[J,I] ↔ X[J];
02500	END;
02600		FLGZ	←	FALSE;
02700	END	"SPLINE";
02800	
02900	α COMPUTE LINEAR COEFFICIENT FOR A GRADE;
03000		REAL DZ;
03100	PROCEDURE GRADE (REAL L0,Z0,L1,Z1);
03200	BEGIN
03300		FLGZ	←	TRUE;
03400		DZ	←	(Z1-Z0) / (L1-L0);
03500	END;
     

00100	α .MAP FILE OPENING CEREMONIES;
00200	BEGIN	"OPENINGS"
00300		LABEL L1,L2;
00400		INTEGER FLG;
00500		STRING FILNAM;
00600		OPEN(1,"DSK",8,3,0,0,0,0);
00700	L1:	OUTSTR(".MAP FILE = ");
00800		FILNAM	←	INCHWL;
00900		LOOKUP(1,FILNAM&".MAP",FLG);
01000		IF FLG THEN GO L1;
01100		OPEN(2,"DSK",8,1,1,0,0,0);
01200	L2:	OUTSTR(".V3D FILE = ");
01300		FILNAM	←	INCHWL;
01400		ENTER(2,FILNAM&".V3D",FLG);
01500		LOOKUP(2,FILNAM&".V3D",FLG);
01600		IF FLG THEN GO L2;
01700		WORDOUT(2,0);
01800	END	"OPENINGS";
01900	α READ MAP HEADER;
02000		N1	←	WORDIN(1);
02100		N2	←	WORDIN(1);
02200		N3	←	WORDIN(1);
02300	α THE 511 SQUARE;
02400		DPYSET(DPYBUF);
02500		AIVECT(-511,-511);
02600		 AVECT( 511,-511);
02700		 AVECT( 511, 511);
02800		 AVECT(-511, 511);
02900		 AVECT(-511,-511);
03000		DPYOUT(0);
     

00100	BEGIN	"DATA BLK"
00200		REAL DISPLACEXY,DISPLACEZ,DU,DV,DL;
00300		REAL U,X,Y,Z,X1,Y1,X2,Y2,X3,Y3,DPYX,DPYY,SEGLENGTH,ARCLENGTH;
00400		REAL DX,DY,VX,VY,R;
00500		INTEGER P1,P2,P3,I,J,N,ARCSEGPTR,PLZPTR,POG;
00600		LABEL L;
00700	α LINE SEGMENT DISPLAY;
00800		PROCEDURE DPYSEG;	IF 15 < SQRT((DPYX-X)↑2+(DPYY-Y)↑2) THEN
00900		AVECT (1.5*(DPYX←X),1.5*(DPYY←Y));
01000	α MAP ARRAYS;
01100		REAL ARRAY PXY[1:N1,1:2],PLZ[1:N2,1:2];
01200		INTEGER ARRAY ARCSEG[0:N3];
     

00100	α COMPUTE Z-ELEVATION AS A FUNCTION 
00200	     OF THE PARAMETRIC VARIABLE U, LENGTH DOWN THE ROAD;
00300	PROCEDURE ZELEV;
00400	BEGIN	"ZELEV"
00500	
00600		DEFINE	A = "COEF[1]";
00700		DEFINE	B = "COEF[2]";
00800		DEFINE	C = "COEF[3]";
00900		DEFINE	D = "COEF[4]";
01000	
01100		DEFINE L0 = "PLZ[PLZPTR  ,1]",	Z0 = "PLZ[PLZPTR  ,2]";
01200		DEFINE L1 = "PLZ[PLZPTR+1,1]",	Z1 = "PLZ[PLZPTR+1,2]";
01300		DEFINE L2 = "PLZ[PLZPTR+2,1]",	Z2 = "PLZ[PLZPTR+2,2]";
01400		DEFINE L3 = "PLZ[PLZPTR+3,1]",	Z3 = "PLZ[PLZPTR+3,2]";
01500	
01600	α FIRST TEST FOR END OF GRADE OR END OF SPLINE;
01700		IF FLGZ THEN
01800		IF U>L1 THEN SPLINE(L1,Z1,L2,Z2,L3,Z3) ELSE 
01900			ELSE
02000		IF U>L3 THEN BEGIN PLZPTR ← PLZPTR+3;GRADE(L0,Z0,L1,Z1);END;
02100	
02200	α SECOND COMPUTE THE Z-ELEVATION ON THE CURRENT GRADE OR SPLINE;
02300		IF FLGZ THEN  	Z	←	Z0 + (U-L0)*DZ 
02400			ELSE	Z	←	((A*U + B)*U + C)*U + D;
02500		Z	←	Z + DISPLACEZ;
02600	
02700	END	"ZELEV";
     

00100	α READ THE MAP INTO CORE;
00200		ARRYIN(1,PXY[1,1],2*N1);
00300		ARRYIN(1,PLZ[1,1],2*N2);
00400		ARRYIN(1,ARCSEG[0], N3+1);
00500		RELEASE(1);
00600	L:	Z ← U ←	0;
00700	α GET ARGUMENTS FROM THE USER;
00800	BEGIN	"GETARG"
00900		STRING STR;
01000		INTEGER CHR;
01100	
01200		OUTSTR ("HORIZONTAL DISPLACEMENT = ");
01300		STR	←	INCHWL;
01400		DISPLACEXY	←	REALSCAN(STR,CHR);
01500		IF CHR="""" THEN DISPLACEXY←DISPLACEXY/12;
01600	
01700		OUTSTR ("VERTICAL   DISPLACEMENT = ");
01800		STR	←	INCHWL;
01900		DISPLACEZ	←	REALSCAN(STR,CHR);
02000		IF CHR="""" THEN DISPLACEZ←DISPLACEZ/12;
02100	
02200		OUTSTR (" LENGTH QUANTUM         = ");
02300		STR	←	INCHWL;
02400		DU	←	REALSCAN(STR,CHR);
02500	
02600		OUTSTR (" ARC    QUANTUM         = ");
02700		STR	←	INCHWL;
02800		DV	←	REALSCAN(STR,CHR)*π/180;
02900	END	"GETARG";
     

00100	α INITIALIZATION;
00200		P1	←	ARCSEG[0];
00300		P2	←	ARCSEG[1] LSH  -18;
00400		P3	←	ARCSEG[1] LAND '777777;
00500		X1	←	PXY[P1,1];		Y1	←	PXY[P1,2];
00600		X2	←	PXY[P2,1];		Y2	←	PXY[P2,2];
00700		IF P3=0 THEN
00800	BEGIN
00900		DX	←	X2-X1;
01000		DY	←	Y2-Y1;
01100		R	←	SQRT (DX↑2 + DY↑2);
01200		VX	←	 DY / R;
01300		VY	←	-DX / R;
01400	END	ELSE
01500	BEGIN
01600		X3	←	PXY[P3,1];		Y3	←	PXY[P3,2];
01700		X1	←	X1 - X3;		Y1	←	Y1 - Y3;
01800		X2	←	X2 - X3;		Y2	←	Y2 - Y3;
01900		IF X1*Y2 > X2*Y1 THEN BEGIN X1 ← -X1; Y1 ← -Y1; END;
02000		R	←	SQRT (X1↑2 + X2↑2);
02100		VX	←	X1 / R;
02200		VY	←	Y1 / R;
02300	END;
02400		X	←	X1 + VX*DISPLACEXY;
02500		Y	←	Y1 + VY*DISPLACEXY;
02600		Z	←	PLZ[1,2] + DISPLACEZ;
02700		ARRYOUT(2,X,3);
02800		DPYX	←	X;
02900		DPYY	←	Y;
03000		IF POG=0 THEN POG←1;
03100		DPYSET (DPYBUF);
03200		AIVECT (1.5*X,1.5*Y);
03300		P2	←	P1;
03400		ARCSEGPTR←	POINT(18,ARCSEG[1],-1);
03500		GRADE(PLZ[1,1],PLZ[1,2],PLZ[2,1],PLZ[2,2]);
03600		PLZPTR	←	1;
     

00100	α MAIN LOOP;
00200		FOR I←1 STEP 1 UNTIL N3 DO
00300	BEGIN	"MAIN"
00400		DPYSST(CVS(I));		AIVECT(1.5*DPYX,1.5*DPYY);
00500		P1	←	P2;
00600		P2	←	ILDB (ARCSEGPTR);
00700		P3	←	ILDB (ARCSEGPTR);
00800		IF P3=0 THEN
00900	BEGIN	"SEGMENT"
01000		X1	←	PXY[P1,1];	Y1	←	PXY[P1,2];
01100		X2	←	PXY[P2,1];	Y2	←	PXY[P2,2];
01200		DX	←	X2 - X1;	DY	←	Y2 - Y1;
01300		SEGLENGTH	←	SQRT (DX↑2 + DY↑2);
01400		N		←	SEGLENGTH / DU;
01500		IF N=0 THEN N←1;
01600		DL		←	SEGLENGTH / N;
01700		DX		←	DX / N;
01800		DY		←	DY / N;
01900		FOR J←1 STEP 1 UNTIL N DO
02000	BEGIN
02100		X	←	X + DX;
02200		Y	←	Y + DY;
02300		U	←	U + DL;
02400		ZELEV;
02500		ARRYOUT(2,X,3);
02600		DPYSEG;
02700	END;
02800		N4	←	N4 + N;
02900	END	"SEGMENT"	ELSE
     

00100	BEGIN	"ARC"
00200		REAL β,Cβ,Sβ,COSINE;
00300		X1	←	PXY[P1,1];	Y1	←	PXY[P1,2];
00400		X2	←	PXY[P2,1];	Y2	←	PXY[P2,2];
00500		X3	←	PXY[P3,1];	Y3	←	PXY[P3,2];
00600		X1	←	X1 - X3;	Y1	←	Y1 - Y3;
00700		X2	←	X2 - X3;	Y2	←	Y2 - Y3;
00800		R	←	SQRT ((X1↑2 + Y1↑2 + X2↑2 + Y2↑2)/2);
00900		COSINE	←	(X1*X2 + Y1*Y2) /(SQRT(X1↑2 + Y1↑2)*SQRT(X2↑2 + Y2↑2));
01000		β	←	ACOS(COSINE);
01100		ARCLENGTH	←	R*β;
01200		N	←	ARCLENGTH / DU;
01300		IF N=0 THEN N←1;
01400		DL	←	ARCLENGTH / N;
01500		β	←	β/N;
01600		Cβ	←	COS(β);
01700		Sβ	←	SIN(β);
01800		IF X1*Y2 < X2*Y1 THEN Sβ ← -Sβ;
01900		VX	←	X-X3;
02000		VY	←	Y-Y3;
02100		FOR J←1 STEP 1 UNTIL N DO 
02200	BEGIN
02300		REAL VXX;
02400		VXX	←	Cβ*VX - Sβ*VY;
02500		VY	←	Cβ*VY + Sβ*VX;
02600		VX	←	VXX;
02700		X	←	X3 + VX;
02800		Y	←	Y3 + VY;
02900		U	←	U +DL;
03000		ZELEV;
03100		ARRYOUT(2,X,3);
03200		DPYSEG;
03300	END;
03400		N4	←	N4 + N;
03500	END	"ARC";
03600	
03700	END	"MAIN";
03800		AVECT(1.5*X,1.5*Y);
03900		DPYOUT(POG←POG+1);
04000		OUTSTR(9&CVS(N4)&" 3D VECTORS CREATED."&13&10);
04100		OUTSTR(9&CVOS(N4)&" 3D VECTORS CREATED."&13&10);
     

00100		OUTSTR("CLOSE NOW ?");
00200		IF INCHRW = "N" THEN GO L;
00300	BEGIN
00400		INTEGER ARRAY BLK[1:128];
00500		ARRYOUT(2,BLK[1],128);
00600		USETI(2,1);
00700		ARRYIN(2,BLK[1],128);
00800		BLK[1] ← N4;
00900		USETO(2,1);
01000		ARRYOUT(2,BLK[1],128);
01100		USETO(2,99999);
01200		CLOSE(2);
01300		RELEASE(2);
01400	END;
01500	
01600	END	"DATA BLK";
01700	
01800	END	"TRAJCT";